home *** CD-ROM | disk | FTP | other *** search
/ TPUG - Toronto PET Users Group / TPUG Users Group CD / TPUG Users Group CD.iso / AMIGA / (A)Z / (A)Z11.ADF / LOGO / LOGOSOURCE / storage.c < prev    next >
C/C++ Source or Header  |  1987-06-29  |  5KB  |  250 lines
  1.  
  2. #include "logo.h"
  3.  
  4. extern struct object *allocstk[];
  5.  
  6. char *ckmalloc(size)
  7. int size;
  8. {
  9.     register char *block;
  10.     extern char *malloc();
  11.  
  12.     block = malloc(size);
  13.     if (block==0) {
  14.         printf("No more memory, sorry.\n");
  15.         errhand();
  16.     }
  17. #ifdef DEBUG
  18.     if (memtrace) {
  19.         printf("Malloc size=%d loc=0%o\n",size,block);
  20.     }
  21. #endif
  22.     return(block);
  23. }
  24.  
  25. char *ckzmalloc(size)
  26. int size;
  27. {
  28.     register char *block;
  29.     register int *ip;
  30.  
  31.     block = ckmalloc(size);
  32.     for (ip = (int *)block; (char *)ip < block+size; )
  33.         *ip++ = 0;
  34.     return(block);
  35. }
  36.  
  37. mfree(ptr)    /* free allocated space, allowing another chunk to be */
  38. register struct object *ptr;
  39. {
  40.     register struct object **i;
  41.  
  42. #ifdef DEBUG
  43.     if(ptr==(struct object *)-1) {
  44.         puts("mfree of -1");
  45.         return;
  46.     }    /* BH 3/5/80 bug trap */
  47. #endif
  48.     if (ptr==0) return; /* BH 3/5/80 this is ok */
  49.     for (i = allocstk; i < &allocstk[MAXALLOC]; i++)
  50.         if (*i == ptr) break;
  51. #ifdef DEBUG
  52.     if (*i != ptr) {
  53.         pf1("Trying to mfree nonlocal at 0%o val=%p\n",ptr,ptr);
  54.         return;
  55.     }
  56.     if (memtrace)
  57.         pf1("\nMfree entry=%d loc=0%o val=%p\n",i,ptr,ptr);
  58. #endif
  59.     *i = 0;
  60.     lfree(ptr);
  61. }
  62.  
  63. lfree(ptr)
  64. register struct object *ptr;
  65. {
  66. #ifdef DEBUG
  67.     if(ptr== (struct object *)-1){
  68.         puts("lfree of -1");
  69.         return;
  70.     }
  71. #endif
  72.     if(ptr==0) return;
  73.     if (--(ptr->refcnt) > 0) return;
  74. #ifdef DEBUG
  75.     if ((ptr->refcnt) < 0) {
  76.         printf("Trying to lfree negative refcnt, loc=0%o\n",
  77.                 ptr);
  78.         return;
  79.     }
  80.     if (memtrace) {
  81.         (ptr->refcnt)++;
  82.         pf1("\nLfree loc=0%o val=%p\n",ptr,ptr);
  83.         (ptr->refcnt)--;
  84.     }
  85. #endif
  86.     if (listp(ptr)) {
  87.         lfree(ptr->obcar);
  88.         lfree(ptr->obcdr);
  89.     }
  90.     if (stringp(ptr)) {
  91. #ifdef DEBUG
  92.         if (memtrace)
  93.             printf("Lfree frees string %s at 0%o\n",
  94.                     ptr->obstr,ptr->obstr);
  95. #endif
  96.         free(ptr->obstr);
  97.     }
  98.     free(ptr);
  99. }
  100.  
  101. #ifdef SMALL
  102. /* In small Logo, refcnts are chars.  Make an actual copy for things with
  103.  * lots of references, which should be rare. */
  104. struct object *realcopy(old)
  105. register struct object *old;
  106. {
  107.     register struct object *new;
  108.  
  109.     new = (struct object *)ckmalloc(sizeof(struct object));
  110.     new->obtype = old->obtype;
  111.     new->refcnt = 0;
  112.     switch (new->obtype) {
  113.         case CONS:
  114.             new->obcar = globcopy(old->obcar);
  115.             new->obcdr = globcopy(old->obcdr);
  116.             break;
  117.         case INT:
  118.             new->obint = old->obint;
  119.             break;
  120.         case DUB:
  121.             new->obdub = old->obdub;
  122.             break;
  123.         default:    /* STRING */
  124.             new->obstr = ckmalloc(1+strlen(old->obstr));
  125.             strcpy(new->obstr,old->obstr);
  126.     }
  127.     return(new);
  128. }
  129. #endif
  130.  
  131. struct object *localize(new)
  132. register struct object *new;
  133. {
  134.     register struct object **i;
  135.  
  136.     if (new==0) return(0);
  137.     for (i = allocstk; i < &allocstk[MAXALLOC]; i++)
  138.         if (*i == 0) break;
  139.     if (*i != 0) {
  140.         puts("I can't remember everything you have told me.");
  141.         puts("Please enter less complex instructions.");
  142.         errhand();
  143.     }
  144. #ifdef SMALL
  145.     if (new->refcnt == 127) new = realcopy(new);
  146. #endif SMALL
  147.     *i = new;
  148.     new->refcnt++;
  149.     return(new);
  150. }
  151.  
  152. struct object *globcopy(obj)
  153. register struct object *obj;
  154. {
  155.     if (obj==0) return(0);
  156. #ifdef SMALL
  157.     if (obj->refcnt == 127) obj = realcopy(obj);
  158. #endif SMALL
  159.     obj->refcnt++;
  160.     return(obj);
  161. }
  162.  
  163. struct object *globcons(first,rest)
  164. register struct object *first,*rest;
  165. {
  166.     register struct object *new;
  167.  
  168.     new = (struct object *)ckmalloc(sizeof(struct object));
  169.     new->obtype = CONS;
  170.     new->refcnt = 0;
  171.     new->obcar = globcopy(first);
  172.     new->obcdr = globcopy(rest);
  173.     return(new);
  174. }
  175.  
  176. struct object *loccons(first,rest)
  177. struct object *first,*rest;
  178. {
  179.     return(localize(globcons(first,rest)));
  180. }
  181.  
  182. struct object *objstr(string)
  183. register char *string;
  184. {
  185.     register struct object *new;
  186.  
  187.     new = (struct object *)ckmalloc(sizeof(struct object));
  188.     new->obtype = STRING;
  189.     new->refcnt = 0;
  190.     new->obstr = string;
  191.     return(new);
  192. }
  193.  
  194. struct object *objcpstr(string)
  195. register char *string;
  196. {
  197.     register struct object *new;
  198.     register char *newstr;
  199.  
  200.     newstr = ckmalloc(strlen(string)+1);
  201.     strcpy(newstr,string);
  202.     new = (struct object *)ckmalloc(sizeof(struct object));
  203.     new->obtype = STRING;
  204.     new->refcnt = 0;
  205.     new->obstr = newstr;
  206.     return(new);
  207. }
  208.  
  209. struct object *objint(num)
  210. FIXNUM num;
  211. {
  212.     register struct object *new;
  213.  
  214.     new = (struct object *)ckmalloc(sizeof(struct object));
  215.     new->obtype = INT;
  216.     new->refcnt = 0;
  217.     new->obint = num;
  218.     return(new);
  219. }
  220.  
  221. struct object *objdub(num)
  222. NUMBER num;
  223. {
  224.     register struct object *new;
  225.  
  226.     new = (struct object *)ckmalloc(sizeof(struct object));
  227.     new->obtype = DUB;
  228.     new->refcnt = 0;
  229.     new->obdub = num;
  230.     return(new);
  231. }
  232.  
  233. struct object *bigsave(string)
  234. register char *string;
  235. /* used by stringform to get an extra null at the end, kludge */
  236. /* Note -- returned object is localized! */
  237. {
  238.     register char *newstr;
  239.     register struct object *newobj;
  240.  
  241.     newstr = ckmalloc(2+strlen(string));
  242.     strcpy(newstr,string);
  243.     newobj = (struct object *)ckmalloc(sizeof(struct object));
  244.     newobj->obtype = STRING;
  245.     newobj->refcnt = 0;
  246.     newobj->obstr = newstr;
  247.     return(localize(newobj));
  248. }
  249.  
  250.